unit UnbindSrc;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FIBDatabase, pFIBDatabase, FIBQuery, pFIBQuery, StdCtrls, DB,
  FIBDataSet, pFIBDataSet, Menus, cxLookAndFeelPainters, cxButtons,
  dxSkinsCore, cxControls, cxContainer, cxEdit, cxTextEdit, cxMaskEdit,
  cxDropDownEdit, cxCalendar, ExtCtrls;

type
  TfUnbindBlobs = class(TForm)
    CurDB:       TpFIBDatabase;
    CurTran:     TpFIBTransaction;
    q:           TpFIBQuery;
    BDB:         TpFIBDatabase;
    BTran:       TpFIBTransaction;
    qBlobs:      TpFIBQuery;
    mLog:        TMemo;
    btnLoadBlobFields: TcxButton;
    btnTriggers: TcxButton;
    ds:          TpFIBDataSet;
    btnCreateBlobIDFields: TcxButton;
    btnExportBlobs: TcxButton;
    btnClearBlobs: TcxButton;
    trDS:        TpFIBTransaction;
    btnBatch:    TcxButton;
    lblNote:     TLabel;
    lblBase:     TLabel;
    btnUpdate:   TcxButton;
    deUpdateFrom: TcxDateEdit;
    btnSchedule: TcxButton;
    tSchedule:   TTimer;
    deSchedule:  TcxDateEdit;
    procedure btnLoadBlobFieldsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnTriggersClick(Sender: TObject);
    procedure btnClearBlobsClick(Sender: TObject);
    procedure btnCreateBlobIDFieldsClick(Sender: TObject);
    procedure btnExportBlobsClick(Sender: TObject);
    procedure btnBatchClick(Sender: TObject);
    procedure btnUpdateClick(Sender: TObject);
    procedure btnScheduleClick(Sender: TObject);
    procedure tScheduleTimer(Sender: TObject);
  private
    iMissed:  integer;
    slFields: TStringList;
    procedure DeleteFieldFromLog(TableName: string; FieldName: string);
  public
    { Public declarations }
  end;

var
  fUnbindBlobs: TfUnbindBlobs;

implementation

{$R *.dfm}

procedure TfUnbindBlobs.DeleteFieldFromLog(TableName: string; FieldName: string);
var
  code: string;
  bi: integer;
begin
  TableName  := UpperCase(TableName);
  FieldName  := UpperCase(FieldName);
  // UPDATE TRIGGER
  Q.SQL.Text := Format(
    'SELECT RDB$TRIGGER_SOURCE FROM RDB$TRIGGERS WHERE RDB$TRIGGER_NAME = ''IBE$%s_AU'' AND RDB$RELATION_NAME = ''%s''',
    [TableName, TableName]);
  Q.ExecQuery;
  code := UpperCase(Q.Fields[0].AsString);
  if Trim(code) <> '' then
  begin
    code := StringReplace(code, Format(
      'INSERT INTO IBE$LOG_BLOB_FIELDS (LOG_TABLES_ID, FIELD_NAME, OLD_BLOB_VALUE, NEW_BLOB_VALUE)'#13#10 + '         VALUES (:TID, ''%s'', OLD.%s, NEW.%s);',
      [FieldName, FieldName, FieldName]), '', [rfIgnoreCase]);
    // recompile trigger
    Q.SQL.Text := Format('CREATE OR ALTER TRIGGER IBE$%s_AU FOR %s'#13 +
      'ACTIVE AFTER UPDATE POSITION 0'#13 + '%s', [TableName, TableName, code]);
    Q.ExecQuery;
  end;

  // INSERT TRIGGER
  Q.SQL.Text := Format(
    'SELECT RDB$TRIGGER_SOURCE FROM RDB$TRIGGERS WHERE RDB$TRIGGER_NAME = ''IBE$%s_AI'' AND RDB$RELATION_NAME = ''%s''',
    [TableName, TableName]);
  Q.ExecQuery;
  code := UpperCase(Q.Fields[0].AsString);
  if Trim(code) <> '' then
  begin
    bi := Pos(UpperCase(Format('%s', [FieldName])), code);
    if bi <> 0 then
      raise Exception.Create('Insert triggers are not processed!');
  end;
  // DELETE TRIGGER
  Q.SQL.Text := Format(
    'SELECT RDB$TRIGGER_SOURCE FROM RDB$TRIGGERS WHERE RDB$TRIGGER_NAME = ''IBE$%s_AD'' AND RDB$RELATION_NAME = ''%s''',
    [TableName, TableName]);
  Q.ExecQuery;
  code := UpperCase(Q.Fields[0].AsString);
  if Trim(code) <> '' then
  begin
    code := StringReplace(code, Format(
      'INSERT INTO IBE$LOG_BLOB_FIELDS (LOG_TABLES_ID, FIELD_NAME, OLD_BLOB_VALUE, NEW_BLOB_VALUE)'#13#10 + '         VALUES (:TID, ''%s'', OLD.%s, NULL);', [FieldName, FieldName]),
      '', [rfIgnoreCase]);
    // recompile trigger
    Q.SQL.Text := Format('CREATE OR ALTER TRIGGER IBE$%s_AD FOR %s'#13 +
      'ACTIVE AFTER UPDATE POSITION 0'#13 + '%s', [TableName, TableName, code]);
    Q.ExecQuery;
  end;
end;

procedure TfUnbindBlobs.btnLoadBlobFieldsClick(Sender: TObject);
var
  i: integer;
begin
  ds.SelectSQL.Text :=
    'select'#13 + '  rf.rdb$relation_name,'#13 + '  rf.rdb$field_name'#13 +
    'from RDB$RELATION_FIELDS rf'#13 +
    'join rdb$fields f on rf.rdb$field_source = f.rdb$field_name'#13 +
    'where f.rdb$field_type = 261 and rf.rdb$system_flag = 0'#13 + 'order by 1,2'#13;
  ds.Open;
  while not ds.EOF do
  begin
    if Copy(ds.Fields[0].AsString, 1, 4) <> 'IBE$' then
      slFields.Values[ds.Fields[0].AsString] := ds.Fields[1].AsString;
    ds.Next;
  end;
  ds.Close;
  mLog.Lines.Clear;// := slFields;
  mLog.Lines := slFields;
  mLog.Lines.Add('Blob fields list created!');
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TcxButton then
      (Components[i] as TcxButton).Enabled := True;
end;

procedure TfUnbindBlobs.FormCreate(Sender: TObject);
begin
  CurDB.Connected := True;
  slFields := TStringList.Create;
  iMissed  := 0;
  deUpdateFrom.Date := Now - 7;
  deSchedule.Date := Now;
end;

procedure TfUnbindBlobs.FormDestroy(Sender: TObject);
begin
  slFields.Free;
end;

procedure TfUnbindBlobs.btnTriggersClick(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to slFields.Count - 1 do
    DeleteFieldFromLog(slFields.Names[i], slFields.ValueFromIndex[i]);
  mLog.Lines.Add('Recompiled all triggers!');
end;

procedure TfUnbindBlobs.btnClearBlobsClick(Sender: TObject);
var
  i: integer;
begin
  if iMissed > 0 then
    mLog.Lines.Add('ERROR: Can''t drop old fields because ' + IntToStr(
      iMissed) + ' are missing!')
  else
  begin
    // clear old blob fields
    for i := 0 to slFields.Count - 1 do
      try
        q.SQL.Text := Format('ALTER TABLE %s DROP %s',
          [slFields.Names[i], slFields.ValueFromIndex[i]]);
        q.ExecQuery;
      except
        on E: Exception do
          mLog.Lines.Add(E.Message);
      end;
    mLog.Lines.Add('Dropped old blob fields!');
  end;
  // clear IBE$LOG blob fields
  for i := 0 to slFields.Count - 1 do
    try
      q.SQL.Text := 'delete from IBE$LOG_BLOB_FIELDS';
      q.ExecQuery;
    except
      on E: Exception do
        mLog.Lines.Add(E.Message);
    end;
  mLog.Lines.Add('Cleaned up IBE logs!');
end;

procedure TfUnbindBlobs.btnCreateBlobIDFieldsClick(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to slFields.Count - 1 do
    try
      q.SQL.Text := Format(
        'select count(*) from RDB$RELATION_FIELDS where rdb$field_name = ''BLOB_ID'' and rdb$relation_name = ''%s''',
        [slFields.Names[i]]);
      q.ExecQuery;
      if q.Fields[0].AsInteger = 0 then
      begin
        q.SQL.Text := Format('ALTER TABLE %s ADD BLOB_ID D_INT', [slFields.Names[i]]);
        q.ExecQuery;
      end;
    except
      on E: Exception do
        mLog.Lines.Add(E.Message);
    end;
  mLog.Lines.Add('Added all fields!');
end;

procedure TfUnbindBlobs.btnExportBlobsClick(Sender: TObject);

  function GenPKQuery(tablename, keytype: string): string;
  begin
    Result := Format('SELECT R.RDB$FIELD_NAME'#13 + 'FROM RDB$RELATION_FIELDS R'#13 +
      'LEFT JOIN RDB$INDEX_SEGMENTS S ON S.RDB$FIELD_NAME=R.RDB$FIELD_NAME'#13 +
      'LEFT JOIN RDB$INDICES I ON I.RDB$INDEX_NAME = S.RDB$INDEX_NAME'#13 +
      '  AND I.RDB$RELATION_NAME=R.RDB$RELATION_NAME'#13 +
      'LEFT JOIN RDB$RELATION_CONSTRAINTS RC ON RC.RDB$INDEX_NAME = S.RDB$INDEX_NAME'#13 +
      '  AND RC.RDB$INDEX_NAME = I.RDB$INDEX_NAME'#13 +
      '  AND RC.RDB$RELATION_NAME = I.RDB$RELATION_NAME'#13 +
      'LEFT JOIN RDB$REF_CONSTRAINTS REFC ON RC.RDB$CONSTRAINT_NAME = REFC.RDB$CONSTRAINT_NAME'#13 + 'WHERE R.RDB$RELATION_NAME=''%s'''#13 + '  AND RC.RDB$CONSTRAINT_TYPE = ''%s''',
      [tablename, keytype]);
  end;

var
  i:  integer;
  pk: string;
begin
  iMissed := 0;
  for i := 0 to slFields.Count - 1 do
    try
      q.SQL.Text := GenPKQuery(slFields.Names[i], 'PRIMARY KEY');
      q.ExecQuery;
      pk := Trim(q.Fields[0].AsString);
      if pk = '' then
      begin
        q.SQL.Text := GenPKQuery(slFields.Names[i], 'UNIQUE');
        q.ExecQuery;
        pk := Trim(q.Fields[0].AsString);
      end;
      if pk = '' then
        raise Exception.Create('Primary key doesn''t exist for table ' +
          slFields.Names[i]);
      ds.Close;
    {ds.SelectSQL.Text := Format('select %s,%s from %s where %s is not null and blob_id is null',
      [
       pk,
       slFields.ValueFromIndex[i],
       slFields.Names[i],
       slFields.ValueFromIndex[i]
      ]); }
      ds.SelectSQL.Text := Format(
        'select %s from %s where %s is not null and blob_id is null',
        [pk, slFields.Names[i], slFields.ValueFromIndex[i]]);
      ds.Open;
      while not ds.EOF do
      begin
        q.SQL.Text := Format('SELECT %s FROM %s WHERE %s = %d',
          [slFields.ValueFromIndex[i], slFields.Names[i], pk, ds.Fields[0].AsInteger]);
        q.ExecQuery;

        qBlobs.SQL.Text := 'select o$id from SET_BLOB(:blob_data)';
        qBlobs.Prepare;
        qBlobs.Params[0].Value := q.Fields[0].Value;//ds.Fields[1].Value;
        qBlobs.ExecQuery;

        q.SQL.Text := Format('UPDATE %s SET BLOB_ID = %d WHERE %s = %d',
          [slFields.Names[i], qBlobs.Fields[0].AsInteger, pk, ds.Fields[0].AsInteger]);
        q.ExecQuery;

        Caption := 'Table ' + IntToStr(i + 1) + ' of ' + IntToStr(slFields.Count) +
          ' blob ' + IntToStr(ds.recno) + ' BlobID ' + qBlobs.Fields[0].AsString;
        Application.ProcessMessages;

        ds.Next;
      end;
      mLog.Lines.Add('Processed table ' + slFields.Names[i]);
      Application.ProcessMessages;
    except
      on E: Exception do
      begin
        mLog.Lines.Add(E.Message);
        Inc(iMissed);
      end;
    end;
  mLog.Lines.Add('Exported all blobs!');
end;

procedure TfUnbindBlobs.btnBatchClick(Sender: TObject);
begin
  btnLoadBlobFields.Click;
  btnTriggers.Click;
  btnCreateBlobIDFields.Click;
  btnExportBlobs.Click;
  //  btnClearBlobs.Click;
end;

procedure TfUnbindBlobs.btnUpdateClick(Sender: TObject);
var
  i: integer;
begin
  try
    ds.Close;
    ds.SelectSQL.Text :=
      'select distinct'#13 + '  t.table_name,'#13 + '  f.field_name,'#13 +
      '  k.key_field,'#13 + '  k.key_value'#13 + 'from IBE$LOG_BLOB_FIELDS f'#13 +
      'join IBE$LOG_TABLES t on f.log_tables_id = t.id'#13 +
      'join IBE$LOG_KEYS k on k.log_tables_id = t.id'#13 +
      'where t.date_time > :LAST_UPDATE';
    ds.Prepare;
    ds.Params[0].Value := deUpdateFrom.Date;
    ds.Open;
    while not ds.EOF do
    begin
      if slFields.IndexOfName(ds.Fields[0].AsString) >= 0 then
      begin
        q.SQL.Text := Format('SELECT %s,BLOB_ID FROM %s WHERE %s = %d',
          [ds.Fields[1].AsString, ds.Fields[0].AsString, ds.Fields[2].AsString,
          ds.Fields[3].AsInteger]);
        q.ExecQuery;

        if not q.Fields[1].IsNull then
        begin
          // insert
          qBlobs.SQL.Text := 'select o$id from SET_BLOB(:blob_data,:blob_id)';
          qBlobs.Prepare;
          qBlobs.Params[0].Value := q.Fields[0].Value;
          qBlobs.Params[1].Value := q.Fields[1].Value;
          qBlobs.ExecQuery;

          q.SQL.Text := Format('UPDATE %s SET BLOB_ID = %d WHERE %s = %d',
            [ds.Fields[0].AsString, qBlobs.Fields[0].AsInteger,
            ds.Fields[2].AsString, ds.Fields[3].AsInteger]);
          q.ExecQuery;
        end
        else
        if not q.Fields[1].IsNull then
        begin
          // delete
          qBlobs.SQL.Text := 'delete from BLOB_TABLE where ID = :BLOB_ID';
          qBlobs.Prepare;
          qBlobs.Params[0].Value := q.Fields[1].Value;
          qBlobs.ExecQuery;

          q.SQL.Text := Format('UPDATE %s SET BLOB_ID = NULL WHERE %s = %d',
            [ds.Fields[0].AsString, ds.Fields[2].AsString, ds.Fields[3].AsInteger]);
          q.ExecQuery;
        end;

        Caption := 'Table ' + ds.Fields[0].AsString + ' blob ' + IntToStr(ds.recno);
        Application.ProcessMessages;
      end;
      ds.Next;
    end;
  except
    on E: Exception do
      mLog.Lines.Add(E.Message);
  end;
  mLog.Lines.Add('Updated all blob fields!');
end;

procedure TfUnbindBlobs.btnScheduleClick(Sender: TObject);
begin
  tSchedule.Enabled := not tSchedule.Enabled;
  if tSchedule.Enabled then
    btnSchedule.Caption := 'Cancel schedule'
  else
    btnSchedule.Caption := 'Schedule 5-6';
end;

procedure TfUnbindBlobs.tScheduleTimer(Sender: TObject);
begin
  if Now >= deUpdateFrom.Date then
  begin
    tSchedule.Enabled := False;

    btnUpdate.Click;
    btnClearBlobs.Click;
  end;
end;

end.
